home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 June / MacFormat 25.iso / Shareware City / Developers / Little Smalltalk v3.1.4 / Smalltalk Source / inspector.st < prev    next >
Encoding:
Text File  |  1995-01-26  |  11.7 KB  |  488 lines  |  [TEXT/KAHL]
  1. * ***
  2. * Methods for an object inspector
  3. *
  4. * Julian Barkway (c) October 1994. All rights reserved. 
  5. *
  6. * v3.1.3    Initial release.
  7. *
  8. * ***
  9. Class ListPane                  SelectListPane theList
  10. Class InspectorView             Object        iWindow namePane valuePane nameList
  11. Class   ObjectInspector         InspectorView theObject namePMenu valuePMenu
  12. Class   ClassHierarchyInspector InspectorView theClass selectedClass valuePMenu
  13. Class   CollectionInspector     InspectorView theCollection namePMenu
  14. Class       ArrayInspector         CollectionInspector
  15.  
  16. Methods Object 'inspecting'
  17.     inspect 
  18.         ObjectInspector new; inspect: self
  19. ]
  20.  
  21.  
  22. Methods Class 'inspecting'
  23.     inspect 
  24.         ClassHierarchyInspector new; inspect: self
  25. ]
  26.  
  27. Methods Array 'modifying'
  28.     removeValues: aConditionBlock
  29.     | list |
  30.         list <- List new.
  31.         self do: [ :x |
  32.             (aConditionBlock value: x ) ifFalse: [
  33.                 list addLast: x
  34.             ]
  35.         ].
  36.         self become: (list asArray)
  37. ]
  38.  
  39. Methods Class 'modifying'
  40.     addInstanceVariable: aSymbol
  41.     | s |
  42.         variables isNil ifTrue: [
  43.             variables <- Array new: 0
  44.         ].
  45.         s <- variables select: [ :i | aSymbol = i ]. 
  46.         (s size > 0) ifTrue: [
  47.             ^ true
  48.         ]
  49.         ifFalse: [        
  50.             variables <- variables grow: aSymbol.
  51.             ^ false
  52.         ]
  53. |
  54.     removeInstanceVariable: aSymbol
  55.     | s |
  56.         s <- variables select: [ :i | aSymbol = i ]. 
  57.         (s size = 0) ifTrue: [
  58.             ^ true
  59.         ]
  60.         ifFalse: [
  61.             j <- (variables size - 1).
  62.             (j = 0) ifTrue: [
  63.                 variables <- nil
  64.             ]
  65.             ifFalse: [
  66.                 variables removeValues: [ :x | aSymbol = x ]
  67.             ].
  68.             ^ false
  69.         ]
  70. ]
  71.  
  72. Methods IndexedCollection 'inspecting'
  73.     inspect 
  74.         CollectionInspector new; inspect: self
  75. ]
  76.  
  77. Methods Array 'inspecting'
  78.     inspect 
  79.         ArrayInspector new; inspect: self
  80. ]
  81.  
  82. Methods Dictionary 'displaying'
  83.     printString | s |
  84.         s <- self class printString , ' ('.
  85.         self binaryDo: [:x :y | s <- s , (x printString) , ' -> ', 
  86.                     (y printString) , newLine ].
  87.         s <- s , ')'.
  88.         ^ s
  89. ]
  90.  
  91. Methods Link 'accessing'
  92.     key
  93.         ^ key
  94. ]
  95.  
  96. Methods List 'assigning'
  97.     links: aLink
  98.         links <- aLink
  99. |
  100.     addFirstLink: aLink
  101.         (links notNil) ifTrue: [
  102.             aLink link: links.
  103.             links <- aLink
  104.         ]
  105.         ifFalse: [
  106.             aLink link: nil.
  107.             links   <- aLink.
  108.             listEnd <- links
  109.         ]
  110. |
  111.     addLastLink: aLink
  112.         (links isNil)
  113.             ifTrue: [ self addFirstLink: aLink ]
  114.             ifFalse: [
  115.                 listEnd link: aLink.
  116.                 listEnd <- listEnd next 
  117.             ]
  118. ]
  119.  
  120. Methods List 'accessing'
  121.     newDo: aBlock
  122.     | aLink |
  123.     " For each link, perform aBlock using the link as an argument "
  124.     aLink <- links.
  125.     [ aLink notNil ] whileTrue: [
  126.         aBlock value: aLink.
  127.         aLink <- aLink next
  128.     ]
  129. ]        
  130.  
  131. Methods ListPane 'all'
  132. " Implements a pane allowing selections from an ordered list "
  133.     list: aList
  134.         theList <- aList.
  135. |
  136.     list
  137.         ^ theList
  138. |
  139.     setText | t |
  140.         t <- '------------------' , newLine.
  141.         (theList links) binaryDo: [:k :v |
  142.             t <- t , k , newLine
  143.         ].
  144.         t <- t , '------------------'.
  145.         self clearAllText.
  146.         self text: t
  147. |
  148.     getSelectedItem
  149.         ^ theList links at: (self getSelectedKey) ifAbsent: [ ^ nil ].
  150. |
  151.     getSelectedKey | t |
  152.         t <- self selectedText.
  153.          ( (t = '------------------') or:
  154.            [t = ('------------------' , newLine) ]) ifTrue: [
  155.             ^ nil
  156.         ].
  157.         ^ t copyFrom: 1 to: ((t size) - 1).
  158. ]
  159.  
  160. Methods InspectorView 'all'
  161.     makeWindow: aTitle
  162.     | maxW maxH posX posY centreScreen origin |
  163.         maxW <- (smalltalk getMaxScreenArea) right.
  164.         maxH <- (smalltalk getMaxScreenArea) bottom.
  165.         centreScreen <- (0@0).
  166.         origin       <- (0@0).
  167.         centreScreen x: ((maxW / 2) truncated).
  168.         centreScreen y: ((maxH / 2) truncated).
  169.         origin <- centreScreen - (170@200).
  170.         maxW <- 340 min: ((origin x) + (maxW - 70)).
  171.         maxH <- 200 min: ((origin y) + (maxH - 70)).
  172.         iWindow <- Window new; 
  173.             title: aTitle;
  174.             openAt: origin withSize: (maxW@maxH).
  175.         self makePanes
  176. |
  177.     makePanes | ww wh ph pw |
  178.         ww <- (iWindow size) x.
  179.         wh <- (iWindow size) y.
  180.         pw <- (ww / 2) truncated.
  181.         namePane  <- ListPane new;
  182.             boundsFrom: (-1 @ -1) to: (pw @ (wh + 1));
  183.             attachTo: iWindow withSizing: (0 @ 1).
  184.         namePane font: 'geneva'; fontSize: 9; typeFace: 2.
  185.         valuePane <- TextPane new;
  186.             boundsFrom: ((pw - 1) @ -1) to: ((ww + 1) @ (wh + 1));
  187.             attachTo: iWindow withSizing: (1 @ 1).
  188.         valuePane font: 'monaco'; fontSize: 9.
  189. |
  190.     createListFrom: theInspectedObject
  191.         ^ nil
  192. |
  193.     refreshNamePane: theInspectedObject
  194.         namePane list: (self createListFrom: theInspectedObject); setText
  195. |
  196.     makeNamePanePopMenu
  197.         ^ nil
  198. |
  199.     selectName: aKey
  200.         ^ nil
  201. |
  202.     changeValue
  203.         ^ nil
  204. ]
  205.  
  206. Methods ObjectInspector 'all'
  207.     inspect: anObject 
  208.         theObject <- anObject.
  209.         self makeNamePanePopMenu.
  210.         self makeValuePanePopMenu.
  211.         self makeWindow: 'Instance of: ' , ((anObject class) printString).
  212.         namePane button1Action: [:p | valuePane clearAllText ];
  213.                  button2Action: [:p | namePMenu popUpAt: p ];
  214.                  button1DoubleClick: [:p | self selectName: (namePane getSelectedItem)].
  215.         valuePane button2Action: [:p | valuePMenu popUpAt: p ].
  216.         self refreshNamePane: anObject
  217. |
  218.     createListFrom: anObject
  219.     | varNames t j a |
  220.         nameList  <- List new.
  221.         j <- anObject basicSize.
  222.         t <- anObject class.
  223.         [t notNil] whileTrue: [
  224.             varNames <- t variables.
  225.             (varNames notNil) ifTrue: [
  226.                 varNames reverseDo: [:varName |
  227.                     a <- Array new: 2; at: 1 put: (anObject basicAt: j); at: 2 put: j.
  228.                     nameList addFirstLink: (Link new;
  229.                                             value: a;
  230.                                             key: (varName asString)).
  231.                     j <- j - 1
  232.                 ]
  233.             ].
  234.             nameList addFirstLink: (Link new; value: nil; 
  235.                                     key: ('=== ' , (t printString) , ' ===') ).
  236.             t <- t superClass
  237.         ].
  238.         ^ nameList 
  239. |
  240.     makeNamePanePopMenu | i |
  241.         namePMenu <- PopUpMenu new; create.
  242.         namePMenu addItem: 'Inspect' 
  243.                         action: [ 
  244.                             i <- namePane getSelectedItem.
  245.                             i notNil ifTrue: [
  246.                                 (i at: 1) inspect 
  247.                             ]
  248.                         ];
  249.                   addItem: 'Inspect Class Hierarchy'
  250.                         action: [ (theObject class) inspect ]
  251. |
  252.     makeValuePanePopMenu
  253.         valuePMenu <- PopUpMenu new; create.
  254.         valuePMenu addItem: 'Accept' 
  255.                         action: [ self changeValue ];
  256.                    addItem: 'Cancel'
  257.                         action: [ self cancel ].
  258. |
  259.     selectName: aValue
  260.         (aValue notNil) ifTrue: [
  261.             valuePane clearAllText.
  262.             valuePane print: ((aValue at: 1) printString).
  263.             valuePMenu enableItem: 1; enableItem: 2
  264.         ]
  265.         ifFalse: [
  266.             valuePMenu disableItem: 1; disableItem: 2
  267.         ]
  268. |
  269.     changeValue
  270.     | valueArray s |
  271.           valueArray <- namePane getSelectedItem.
  272.           (valueArray notNil) ifTrue: [
  273.             inspectorTemp001 <- theObject.
  274.             s <- 'inspectorTemp001 basicAt: ' , 
  275.             (valueArray at: 2) printString , 
  276.             ' put: ' , (valuePane text).
  277.             [
  278.             (s execute) notNil ifTrue: [
  279.                 valueArray 
  280.                     at: 1  
  281.                     put: (inspectorTemp001 basicAt: (valueArray at: 2))
  282.             ]
  283.             ] fork
  284.         ]
  285. |
  286.     cancel
  287.         valuePane clearAllText.
  288.         valuePMenu disableItem: 1; disableItem: 2
  289. ]
  290.  
  291. Methods ClassHierarchyInspector 'all'
  292.     inspect: aClass 
  293.         theClass <- aClass.
  294.         self makeNamePanePopMenu.
  295.         self makeValuePanePopMenu.
  296.         self makeWindow: 'Class: ' , (aClass printString).
  297.         namePane button1Action: [:p | valuePane clearAllText ];
  298.                  button2Action: [:p | p <- nil ].
  299.         namePane button1DoubleClick: [:p | self selectName: (namePane getSelectedItem)  ].
  300.         valuePane button2Action: [:p | valuePMenu popUpAt: p ].
  301.         self refreshNamePane: aClass
  302. |
  303.     createListFrom: aClass
  304.     | classList dots |
  305.         classList <- List new.
  306.         aClass upSuperclassChain: [:c |
  307.             classList addFirstLink: (Link new; 
  308.                                      value: c; 
  309.                                      key:  (c printString) )
  310.         ].
  311.         dots <- ''.
  312.         classList newDo: [ :lk |
  313.             lk key: (dots , (lk key)). 
  314.             dots <- (dots , '..')
  315.         ].
  316.         ^ classList
  317. |
  318.     makeNamePanePopMenu
  319.         ^ nil
  320. |
  321.     makeValuePanePopMenu
  322.         valuePMenu <- PopUpMenu new; create.
  323.         valuePMenu addItem: 'Add Variables' 
  324.                         action: [ self addVariables ];
  325.                    addItem: 'Remove Variables'
  326.                         action: [ self removeVariables ];
  327.                    addItem: 'Cancel'
  328.                         action: [ self cancel ].
  329. |
  330.     selectName: aClass | v |
  331.         v <- aClass variables.
  332.         valuePane clearAllText.
  333.         (v isNil) ifTrue: [
  334.             valuePane print: '<No instance variables>'.
  335.             valuePMenu enableItem: 1; disableItem: 2; enableItem: 3
  336.         ]
  337.         ifFalse: [
  338.             v do: [:c | valuePane print: (c asString) , newLine ].
  339.             valuePMenu enableItem: 1; enableItem: 2; enableItem: 3
  340.         ].
  341.         selectedClass <- aClass
  342. |
  343.     addVariables | a |
  344.         a <-  (valuePane text) words: [:x | x isAlphaNumeric ].
  345.         a do: [ :x | selectedClass addInstanceVariable: (x asSymbol) ].
  346.         self selectName: selectedClass
  347. |
  348.     removeVariables | a r |
  349.         a <- (valuePane selectedText) words: [:x | x isAlphaNumeric ].
  350.         r <- smalltalk inquire: 'Please confirm removal of ', 
  351.                                 (a size) asString, ' variables'.
  352.         (r isNil) ifFalse: [
  353.             r ifTrue: [
  354.                 a do: [ :x | selectedClass removeInstanceVariable: (x asSymbol) ]
  355.             ]
  356.         ].
  357.         self selectName: selectedClass
  358. |
  359.     cancel
  360.         valuePane clearAllText.
  361.         valuePMenu disableItem: 1; disableItem: 2
  362. ]
  363.  
  364. Methods CollectionInspector 'all'
  365.     inspect: aCollection 
  366.         theCollection <- aCollection.
  367.         self makeNamePanePopMenu.
  368.         self makeValuePanePopMenu.
  369.         self makeWindow: 'Collection: ' , (aCollection class printString).
  370.         namePane button1Action: [:p | valuePane clearAllText ];
  371.                  button2Action: [:p | namePMenu popUpAt: p ].
  372.         namePane button1DoubleClick: [:p | self selectName: (namePane getSelectedItem)  ].
  373.         valuePane button2Action: [:p | valuePMenu popUpAt: p ].
  374.         self refreshNamePane: aCollection
  375.  
  376. |
  377.     createListFrom: aCollection | theList a l |
  378.         theList <- List new.
  379.         aCollection binaryDo: [:k :v | 
  380.             l <- Link new.
  381.             a <- Array new: 3; at: 1 put: v; at: 2 put: k; at: 3 put: l. 
  382.             l value: a; key: ((k printString) , ' -> ' , (v printString)).
  383.             theList addLastLink: l 
  384.         ].
  385.         ^ theList
  386. |
  387.     makeNamePanePopMenu | i |
  388.         namePMenu <- PopUpMenu new; create.
  389.         namePMenu addItem: 'Inspect' 
  390.                     action: [ 
  391.                         i <- namePane getSelectedItem.
  392.                         i notNil ifTrue: [
  393.                             (i at: 1) inspect
  394.                         ]
  395.                     ];
  396.                   addItem: 'Add Key' 
  397.                     action: [ self addKey ];
  398.                   addItem: 'Remove Key' 
  399.                     action: [ self removeKey ]
  400. |
  401.     makeValuePanePopMenu
  402.         valuePMenu <- PopUpMenu new; create.
  403.         valuePMenu addItem: 'Accept' 
  404.                         action: [ self changeValue ];
  405.                    addItem: 'Cancel'
  406.                         action: [ self cancel ].
  407. |
  408.     selectName: aValue
  409.         aValue notNil ifTrue: [
  410.             valuePane clearAllText.
  411.             valuePane print: ((aValue at:1) printString).
  412.             valuePMenu enableItem: 1; enableItem: 2
  413.         ]
  414.         ifFalse: [
  415.             valuePMenu disableItem: 1; disableItem: 2
  416.         ]
  417. |
  418.     executeAnAt: atText withPut: putText
  419.     | s | 
  420.         inspectorTemp001 <- theCollection.
  421.         s <- 'inspectorTemp001 at: ', atText, ' put: ', putText.
  422.         ^ (s execute)
  423. |
  424.     addKey
  425.     | ky |
  426.         ky <- smalltalk getPrompt: 'Enter a key:'.
  427.         (ky ~= '') ifTrue: [
  428.             [    
  429.             (self executeAnAt: ky withPut: 'nil') notNil 
  430.             ifTrue: [
  431.                 self refreshNamePane: theCollection
  432.             ]    
  433.             ] fork
  434.         ] 
  435. |
  436.     removeKey
  437.     | valueArray r |
  438.           valueArray <- namePane getSelectedItem.
  439.           (valueArray notNil) ifTrue: [
  440.             r <- smalltalk inquire: ('Please confirm removal of item ', 
  441.                                     ((valueArray at: 2) asString) ).
  442.             (r isNil) ifFalse: [
  443.                 r ifTrue: [
  444.                     theCollection removeKey: (valueArray at: 2).
  445.                     self refreshNamePane: theCollection.
  446.                      valuePane clearAllText
  447.                 ]
  448.             ]
  449.         ]
  450. |
  451.     changeValue
  452.     | valueArray |
  453.           valueArray <- namePane getSelectedItem.
  454.           (valueArray notNil) ifTrue: [
  455.               [
  456.             (self executeAnAt: ((valueArray at: 2) printString) 
  457.                 withPut: (valuePane text))
  458.             notNil ifTrue: [
  459.                 self refreshNamePane: theCollection
  460.             ]
  461.             ] fork
  462.         ]
  463. |
  464.     cancel
  465.         valuePane clearAllText.
  466.         valuePMenu disableItem: 1; disableItem: 2
  467. ]
  468.  
  469. Methods ArrayInspector 'all'
  470.     addKey
  471.         theCollection <- (theCollection grow: nil).
  472.         self refreshNamePane: theCollection
  473. |
  474.     removeKey
  475.     | valueArray r |
  476.           valueArray <- namePane getSelectedItem.
  477.           (valueArray notNil) ifTrue: [
  478.             r <- smalltalk inquire: ('Please confirm removal of item ', 
  479.                                     ((valueArray at: 2) asString) ).
  480.             (r isNil) ifFalse: [
  481.                 r ifTrue: [
  482.                     theCollection removeValues: [ :y | y = (valueArray at: 1) ].
  483.                     self refreshNamePane: theCollection.
  484.                      valuePane clearAllText
  485.                 ]
  486.             ]
  487.         ]
  488. ]